perm filename TREST.F4[NEW,LCS] blob sn#148560 filedate 1975-03-03 generic text, type T, neo UTF8
00100	C******* SUBRS  TAIL, FERMTA, REST, BREP, EXCH, SORT2, NOZERO,
00150	C******* JDRAW,CENTR,LINX,UNPACK,ROFF,NOIR, KSIG, ALPHA
00200		SUBROUTINE TAIL(RJX,RA,RMINI)
00300		COMMON /STF/RSTFAC(8),RSTJ2
00400		COMMON /PLTR/IPLT,RHT,DIS
00500		DIMENSION ITAIL(16)
00600		DATA ITAIL/16,100090007,110012,120016,200120016,120019,100026,
00700		1 80030,20036, 40, 33, 30031, 50029,80025,100022,120016/
00710		CALL CENTER(RJY)
00800		Q=-1.
00900		IF(RA)Q=1.
00905		IF(IPLT)GO TO 2
00910		ITAIL(1)=10
01100	1	CALL JDRAW(ITAIL,RJX,RJY,RMINI,1.,Q)
01200		RETURN
01250	2	P=Q
01300		IF(RMINI.NE.RSTJ2)P=P*.6
01400		ITAIL(1)=16
01500		CALL FILLMS(12,ITAIL(5),RJX,RJY,ABS(P),P)
01600	C RA=-,STEM UP;  RA=+, STEM DOWN.
01650		GO TO 1
01700		END
01800	
01900		SUBROUTINE REST
02000		COMMON /STF/RSTFAC(8),RSTJ2/PLTR/IPLT,RHT,DIS
02100		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
02200		EQUIVALENCE(J5,JQ(3)),(R3,RJQ(1))
02300		DIMENSION LRST(3),IRST(47),MR(2),MF(2)
02400		DATA IRST/9,100000033,160033,160030, 30,32 ,160032 ,160031,
02600		1 31,  23,100000051,100038,32,110017,200050044, 32 ,50026,
02700		1 100038,50044,100110017,70018,50017,50015,60011, 10016,
02800		1 18,  20,10022,30023, 50023, 70022,110017,
02900		1 15,100030033, 40032, 80032,120035,150039,70014,200010037,
03000		1 30039, 50039, 70037, 70035, 50033, 30033,10035/
03100		1,LRST/1,10,33/,MR/18,8/,MF/15,40/
03150	C  LRST = BEGINNING OF EACH REST, MR=FILLER WDCNT, MF=FILL START.
03200	
03400		L=J5
03500		IF(L.GT.1)L=1
03600		IF(L)L=-1
03700	C  L>3 WHEN SEVERAL TAILS ON REST
03800		CALL CENTER(CENTR)
03900		IF(J5.EQ.-2)CENTR=CENTR+9.4*RSTJ2
04000		CALL JDRAW(IRST(LRST(L+2)),R3,CENTR,RSTJ2,1.,1.)
04050		IF(IPLT.GE.0)RETURN
04100		IF(J5)RETURN
04200		L=L+1
04300		CALL FILLMS(MR(L),IRST(MF(L)),R3,CENTR,1.,1.)
04400	C  WHY GO THROUGH NOTWRT??
04500		END
04600	
04800	C  READS DATA 
06100	C  FOR SINGLE (OR DOUBLE) BAR REPEAT SIGN
06200		SUBROUTINE BREP(R3,RSTJ2)
06300		DIMENSION IREP(35)
06400		DATA IREP/35,100000015,280043,290043, 10015, 20015, 300043,310043
06500		1,30015, 40015, 320043,100020037, 30038, 40038, 50037
06600		1,50036, 40035, 30035, 20036, 20037, 50037, 20036, 40036
06700		1,100270022,280021,290021,300022,300023,290024,280024,270023
06800		1,270022, 300022, 270023, 290023/
07000		CALL CENTER(R)
07100		CALL JDRAW(IREP,R3,R,RSTJ2,1.,1.)
07200		END
07300	
07400		SUBROUTINE FERMTA(RINV)
07500		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
07600		COMMON /PLTR/IPLT,RHT,DIS
07700		COMMON /STF/RSTFAC(8),RSTJ2
07800		DIMENSION JFERM(45)
07850		EQUIVALENCE (R3,RJQ(1))
07900		DATA JFERM/24,310020003,10010010,20015,60017,110017,160015,
08000		1 190010,200003,170010,150012,120014,70014,30012,10010,
08100		1 10020003,100070007,80008,100008,110007,110006,100005,80005
08200		1 ,70006, 20,100081006, 80012,  90012,  91006, 110030002, 30008,
08300		1 70002,130008,170002, 200005, 200170002,141001,100005,130008,
08400		1 170002, 100070002, 41001, 5, 30008, 70002/
08410		IF(RINV.LT.17)GO TO 1
08420		JFERM(29)=16
08425		JFERM(35)=210005
08430		IF(RINV.NE.17)GO TO 2
08435		JFERM(29)=91006
08440		J=25
08450		GO TO 4
08460	2	JFERM(29)=16
08470	C  FOR INVERTED MORDANT
08480		J=29
08485	4	RINV=1.
08490		GO TO 3
08500	1	J=1
08590	3	CALL JDRAW(JFERM(J),R3,CENTR,RSTJ2,1.,RINV)
08700		IF(IPLT.GE.0)RETURN
08710		IF(J.EQ.1)GO TO 5
08720		J=35
08730		JFERM(35)=10
08750	5	CALL FILLMS(JFERM(J),JFERM(J+1),R3,CENTR,1.,RINV)
08800		END
08900	
09000		SUBROUTINE EXCH(X,Y)
09100		Z=X
09200		X=Y
09300		Y=Z
09400		END
09500		SUBROUTINE SORT2(RPOS,M)
09600		DIMENSION RPOS(2,200)
09700		L=2
09800	3	J=-1
09900		RX=RPOS(1,L-1)
10000		DO 2 K=L,M
10100		IF(RPOS(1,K).GE.RX)GO TO 2
10200		RX=RPOS(1,K)
10300	C   WHY WERE ALL THE RX'S  JX ????? 9/6/73
10400		J=K
10500	2	CONTINUE
10600		IF(J)GO TO 4
10700		K=L-1
10800		CALL EXCH(RPOS(1,K),RPOS(1,J))
10900		CALL EXCH(RPOS(2,K),RPOS(2,J))
11000	4	L=L+1
11100		IF(L.LE.M)GO TO 3
11200		END
11300	
11400		SUBROUTINE NOZERO(X)
11500		IF(X.EQ.0)X=1
11600		END
11700	
11800		SUBROUTINE PNUM
11900		COMMON R2,JA,CENTR,J2,R3,R4,R5,R6,RJQ(16),J3,J4,J5,
12000		1 J6,J7,J10J,IPUNC,SIZ,RXX,RX,JQ(10)
12100		COMMON /STF/RSTFAC(-3/4),RSTJ2
12200		DIMENSION NUMQ(44),RNUMS(341)
12300		DATA
12347	     1 NUMQ/1,11,15,23,33,38,47,57,62,79, 89,95,108,117,125,132,138
12394	     1,150,157,164,171,177,181,187,1,192,200,212,221,234,239,246
12441	     1,250,256,261,266,  271,282,285,293,298,314,330,335/
12488	      DATA (RNUMS(K),K=1,131)/10.0,1003.107, 6.102, 6.01, 3.015,
12535	     1 104.015, 107.01,107.102, 104.107, 3.107,
12582	     1 14.0, 1105.011, 101.015, 101.107, 22.0,
12629	     1 1106.011, 102.015, 3.015, 7.011, 7.005, 107.107, 7.107, 32.0,
12676	     1 1107.015, 7.015, 101.007, 3.007, 7.003, 7.102, 3.107, 103.107,
12723	     1 107.103, 37.0, 1007.102, 107.102, 2.015, 2.107, 46.0, 1107.107,
12770	     1 4.103, 7.0, 7.004, 2.006, 107.004, 107.015, 7.015, 56.0,
12817	     1 1004.015, 107.0, 107.103, 103.107, 4.107, 7.103, 7.0, 3.003,
12864	     1 104.003, 61.0, 1107.011, 107.015, 7.015, 107.107, 78.0, 1003.004,
12911	     1 7.0, 7.103, 4.107, 104.107, 107.103, 107.0, 103.004, 3.004,
12958	     1 6.008, 6.012, 2.015, 102.015, 106.012, 106.008, 103.004,
13005	     1 88.0, 1104.107, 7.008, 7.011, 4.015, 104.015, 107.011, 107.008,
13052	     1 103.005, 4.005, 94.0, 1106.107, 0.015,6.107,1004.101,104.101,
13099	     1 107.0, 1106.107, 106.015, 3.015, 6.012, 6.007, 3.004, 1106.004,
13146	     1 2.004, 6.001, 6.104, 3.107, 106.107, 116.0, 1006.104, 3.107,
13193	     1 103.107, 106.104, 106.011, 103.015, 3.015, 6.011, 124.0,
13240	     1 1106.107, 106.015, 3.015, 6.011, 6.103, 3.107, 106.107,
13287	     1 131.0, 1006.107, 106.107, 106.015, 6.015, 1003.005, 106.005/
13334	C   THE NEXT IS FOR 'F' TO 'P'
13381	C   1 NUM NOT NEEDED IN 'G'  ALSO IN RNOTE (1/2 NOTE).
13428	      DATA (RNUMS(K),K=132,199)/
13475	     1 137.0, 1106.107, 106.015, 6.015, 1003.005, 106.005, 149.0, 
13522	     1 1001.102, 6.102, 6.104, 6.104, 3.107, 103.107, 106.104, 
13569	     1 106.011, 103.015, 3.015, 6.011, 156.0, 1106.107, 106.015,
13616	     1 1006.015, 6.107, 1006.005, 106.005, 163.0, 1106.107, 0.107,
13663	     1 1103.107, 103.015, 1106.015, 0.015,
13710	     1 170.0, 1110.102, 110.105, 108.107, 103.107, 101.105, 101.015, 
13757	     1 176.0, 1106.107, 106.015, 1006.015, 106.005, 6.107, 180.0,
13804	     1 1006.107, 106.107, 106.015, 186.0, 1106.107, 106.015, 1.004,
13851	     1 8.015, 8.107, 191.0, 1106.107, 106.015, 6.107, 6.015, 199.0
13898	     1, 1106.107, 106.015, 3.015, 6.012, 6.007, 3.004, 106.004/ 
13945	C   'Q' TO ')'
13992	      DATA(RNUMS(K),K=200,341)/
14039	     1 211.0, 1003.107, 6.102, 6.01, 3.015, 103.015, 106.01, 106.102,
14086	     1 103.107, 3.107, 1001.001, 7.108, 220.0, 1106.107, 106.015,
14133	     1 3.015, 6.012, 6.007, 3.004, 106.004, 6.107, 233.0, 1106.104,
14180	     1 103.107, 3.107, 6.104, 6.001, 3.004, 103.004, 106.007, 106.011,
14227	     1 103.015, 3.015, 6.01, 238.0, 1106.015, 7.015, 1000.015, 0.107,
14274	     1 245.0, 1106.015, 106.104, 103.107, 3.107, 6.104, 6.015, 249.0,
14321	     1 1106.015, 0.107, 6.015, 255.0, 1106.015, 103.107, 1.005, 5.107,
14368	     1 8.015, 260.0, 1106.015, 6.107, 1106.107, 6.015, 265.0, 1106.015,
14415	     1 0.003, 1106.107, 6.015, 270.0, 1106.015, 6.015, 106.107, 6.107,
14462	     1 281.0, 1105.102, 105.105,103.105,104.102,104.105,105.102,103.102,
14509	     1103.108, 106.112, 1106.112, 284., 1110.003, 2.003, 292., 1105.102,
14556	     1 105.105,104.102,104.105,103.102,103.105,105.102,297.0,1110.007,
14603	     1 2.007, 1110.0, 2.0, 313.0, 1101.015, 103.013, 105.010,
14650	     1 106.006,106.002,105.102,103.105,101.107, 103.104,104.102,105.002
14673	     1 ,105.006,104.01,103.012,101.015, 329.0,1107.015,105.013,
14697	     1 103.01 ,102.006,102.002,103.102,105.105,107.107, 105.104,104.102
14720	     1 ,103.002,103.006,104.01,105.012,107.015,  334.0,1110.003,
14744	     1 2.003, 1104.009, 104.103,  341.0,1110.004, 2.004, 1101.009,
14791	     1 107.101, 1101.101, 107.009/
14838	C  3RD ITEM IN 19400 NOT NEEDED 12/73
14932	C  1-10=NUMS 0-9, 11-36=ALPHA, 37-42=SIGNS
14966	
15000		CALL CENTX
15100		J10J=J5
15200		CALL NOZERO(R6)
15250		SIZ=R6*RSTJ2
15300		IPUNC=0
15400		IF(J10J.LT.44)GO TO 451
15500		IPUNC=J10J
15600		IF(J10J.EQ.44)J10J=38
15700		IF(J10J.GE.45)J10J=36
15800		IF(J5.NE.46)GO TO 451
15900		RXX=4
16000		CALL RJBX(-RXX)
16100		RX=16
16200		CENTR=CENTR+RX*SIZ
16400	451	IX=NUMQ(J10J+1)
16500	C  IX=END # OF ITEM
16600	C  IX+1=1ST PART OF ITEM
16700	      CALL RDRAW(IX+1,RNUMS(IX),RNUMS,SIZ,R3,CENTR+RSTJ2*3.,SIZ)
16800		IF(IPUNC.EQ.0)RETURN
16900		IF(IPUNC.NE.46)GO TO 351
17000		CALL RJBX(SIZ*2.*RXX)
17100	C  FOR "
17200	651	IPUNC=0
17300		GO TO 451
17400	351	RXX=11
17500	C FOR : AND ;
17600		CENTR=CENTR+RXX*SIZ
17700		J10J=38
17800		GO TO 651
17900		END
     

00100	C****** FOR LISTS OF LETTERS, ETC. AND TRILL *******
00200		SUBROUTINE ALPHA
00300		COMMON /PLTR/IPLT,RHT,DIS /FONT/JFONT
00400		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
00500	       EQUIVALENCE(J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R5,RJQ(3)),
00600		1(R8,RJQ(6)),(NRJ,RJQ(8)),(JX,JQ(11)),(RSX,JQ(12)),
00700		1(R6,RJQ(4)),(J7,JQ(5)),(J8,JQ(6)),(J9,JQ(7)),(J10,JQ(8))
00800		1,(J6,JQ(4)),(R7,RJQ(5)),(R4,RJQ(2)),(IFNT,JQ(13)),
00810		1(NR,JQ(14)),(RSP,JQ(15)),(RY,JQ(16)),(RX,JQ(17)),(RZ,JQ(18)),(RW
00820		1,JQ(19)),(RB,JQ(20)),(R,RJQ(20)),(FILL,RJQ(19))
00825		1,(JTR,RJQ(17)),(RF,RJQ(15)),(JJ2,RJQ(14)),(R3,RJQ(1))
00900		COMMON/STF/RSTFAC(8),RSTJ2
01000		DATA R4X/-2.1/,IFNT/1/, NR/'PRIM0'/
01100	
01200		IF(JA.EQ.7)GO TO 20
01210		JTR=99
01400	C  PRIMITIVE IS DEFAULT FONT.  #=SET BACK TO PRIM.
01500	C ONLY 11 LETTERS WITHOUT FONT RESET.
01700	54	R=19.7*R5*RSTJ2
01800		RB=J3
01810		RW=R4
01900		J9=0
02000	C J9=0 AVOIDS ROTATION IN 'CLEFS'
02300		DO 50 KA=4,6
02400		JY=RJQ(KA)*100.+.2
02500		JX=1000000
02600		DO 53 LA=1,4
02700		J5=JY/JX
02701		J5X=J5
02702		R3=J3
02705		IF(J5.EQ.99)GO TO 55
02707	C NO MORE IN THIS WD.
02710		IF(J5.LT.50)GO TO 1
02800		GO TO(2,3,9,4,5),J5-49
02900	C  SWITCHES FOR DIFF. FONTS. (55 MAKES ')
02925		J5=36
02930		R4=R4+2.9
02937	C  WILL MAKE '.
02950		GO TO 1
03000	2	NR='BDR40'
03100	C  &=NON-ITALICS  --  JFONT IS TEMPORARY SWITCH  5/74
03150		IF(JFONT)GO TO 9
03188		GO TO 11
03226	CC	GO TO 8
03264	3	NR='BDI40'
03302	C  @=51=ITALICS
03340		IF(JFONT)GO TO 9
03378	C  TYPE '44 -1' TO MAKE ALL FONTS INTO 'PRIM'
03416	CC8	IF(IFNT.EQ.0)IFNT=-1
03454		GO TO 11
03500	4	FILL=-2
03600		GO TO 11
03700	5	FILL=0
03800		GO TO 11
03810	9	NR='PRIM0'
03855		GO TO 11
03900	1	CALL SPACER(J5,IFNT,RB,R)
03950		IF(J5-47)7,6,11
07300	7	IF(JFONT.NE.0)GO TO 77
07350		IF(IPLT.GE.0)GO TO 30
07400	C  JFONT=0 FOR FIXED WIDTH OF FONTS.  = AND ONLY DPYS PRIMITIVE.
07600	CC	J5=J6
07610	CC	IF(IFNT.EQ.0)GO TO 30
07650	77	IF(J5.GE.36)GO TO 30
07675	C  PUNCTUATION AND SPACE.
07700		IF(NR.NE.'PRIM0')GO TO 70
07733		IF(IFNT.EQ.1)GO TO 30
07749		IF(J5.LT.10)GO TO 30
07766	C  JUMP TO USE UPPER CASE PRIM. LOWER CASE STARTS IN PRIM1.
07799		GO TO 71
07832	70	IF(J5.LE.9)GO TO 71
07848		IF(IFNT)J5=J5+26
07865	71	RX=R6
07900		R6=R5*.28
08000	C  .29 IS SIZE FACTOR -- PERHAPS CHANGE SIZE IN FONT TO =1.
08100		RY=R7
08200		R7=R6
08300		RZ=R8
08500		R4=R4+R4X
08550	C  SHIFTS DOWN ??? WHY NOT GET RID OF THIS.??
08600		R8=FILL
08700		NRJ=NR
08800	C  GETS RIGHT FILE
08900		JA=11
09025	CC	R2=J2
09050		CALL CLEFS
09100		R6=RX
09200		R7=RY
09300		R8=RZ
09500	C  PUTS BACK RIGHT STUFF
09700		GO TO 6	
09800	
09950	30	J7=0
09960		R6=R5
10000		CALL PNUM
10100	C  47=BLANK  (WAS 99)
10500	6	J3=ROFF(RB)
10600		R4=RW
11000	11	JY=JY-J5X*JX
11100	C TO GET NEXT NUM OUT OF JY
11200	53	JX=JX/100
11300	50	CONTINUE
11310	55	IF(JTR.EQ.99)RETURN
11400		GO TO 52
11500	
11550	
11600	C  FOR TRILLS
11900	C  7, POS1, STF, NT#, SIZE, POS2, X     IF X=1 THEN NO WAVEY LINE
11910	20	CALL NOZERO(R5)
11955		R10=R5
12000		R5=.8*R5
12050		J3=J3+6*RSTJ2
12100		RF=R6
12200		JJ2=J3
12300		R6=495129.27
12400	C  %@tr  LWR CASE, ITAL.  TR
12500		R7=999999.99
12600		R8=R7
12700		JTR=J7
12800		GO TO 54
13000	52	IF(JTR.NE.0)RETURN
13200	C   RETURN IF NO WAVY LINE IS NEEDED
13210		J3=JJ2+20.*RSTJ2*R10
13300		JA=4
13500		J7=-2
13600	C  J7 IS SWITCH TO DRAW WIGGLE
13650		R6=RF
13700		R5=R4+.7*R10
13710		R8=.9*R10
13735	C  R10 IS SIZE (P5)
13750		J10=0
13760		IF(IPLT)J10=1
13800		CALL ITMSUB
13860	C  SINGLE WIGGLE ON DPY, DOUBLE ON PLOTTER.
13900		END
14000	
14100	
14200		SUBROUTINE SPACER(J5,IFNT,RB,R)
14300	C  SPACES ALPHABET ITEMS.
14400		DATA RS/1.08/,RSPC/1./,RLWR/.96/
15200	C  JUMP TO USE PRIMITIVE ALPHABET.
15350		IF(J5.GT.47)GO TO 10
15375		IF(J5.LE.9)GO TO 177
15387		IF(J5.LT.36)GO TO 10
15400	C NEXT FOR NUMBERS, SPACE AND PUNCTUATION.
15500	177	RSX=RSPC
15550		IF(IFNT)RSX=.9
15600		GO TO 3
15700	10	IF(J5.LT.47)GO TO 5
15800		IF(J5.EQ.52)GO TO 14
15900		IF(J5.EQ.48)IFNT=1
16000		IF(J5.EQ.49)IFNT=-1
16050		IF(J5.GE.55)GO TO 5
16075	C  PUNCT. WILL EXPAND ABOVE 54.
16100		RETURN
16200	14	IFNT=0
16300	C  #=52=PRIMITIVE
16400		JA=10
16600		RETURN
17000	5	RSX=RS
17200		IF(IFNT)RSX=RLWR
17250	C  FOR LOWER CASE SPACING.  (96%)
17400		IF(J5.EQ.22)GO TO 277
17450		IF(J5.NE.32)GO TO 3
17475	277	RSX=RSX*1.12
17500	C  FOR M AND W
17702	3	IF(J5.GE.36)GO TO 21
17704		IF(J5.EQ.1)GO TO 21
17706		IF(J5.EQ.18)GO TO 21
17708		IF(J5.EQ.19)GO TO 21
17715	C  FOR 1,I AND J
17717		IF(IFNT.GE.0)GO TO 4
17720	C  NEXT FOR LOWER CASE ONLY.
17731		IF(J5.EQ.15)GO TO 21
17733		IF(J5.EQ.19)GO TO 21
17734		IF(J5.EQ.21)GO TO 21
17736		IF(J5.NE.29)GO TO 4
17745	21	IF(J5.NE.47)RSX=RSX*.68
17750	C  FOR F,I,J,L,T
17800	4	RB=RB+R*RSX
17900		END
18000	
19000	
19100		SUBROUTINE JDRAW(M,R3,CENTR,RSTJ2,RX,RY)
19200		COMMON/LL/LL
19300		DIMENSION M(1)
19400		RC=RX*RSTJ2
19500		RD=RY*RSTJ2
19600		DO 2 K=2,M(1)
19700		CALL UNPACK(IA,IB,M(K))
19800	2	CALL LINES(FLOAT(IA)*RC+R3,FLOAT(IB)*RD+CENTR,LL)
19900		END
20000	
20100		SUBROUTINE CENTER(CNTR)
20200	C  TO CENTER ITEMS CREATED WITH DRAWING PROG.
20300		COMMON /STF/RSTFAC(8),RSTJ2
20400		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
20500		COMMON/POSI/STF(8),JJ2,POS
20600		EQUIVALENCE (R4,RJQ(2))
20700		CNTR=POS+(2+AMOD(R4,100.)*7)*RSTJ2
20800		END
20900	
21000		SUBROUTINE LINX(A,B,C,D)
21100	C  SAVES SPACE FOR SINGLE LINES.
21200		CALL LINES(A,B,3)
21300		CALL LINES(C,D,2)
21400		END
21500	
21600		SUBROUTINE UNPACK(M,N,I)
21700		COMMON/LL/L
21800	C  L IS FOR VIS. OR INVIS. LINES.
21900		N=I
22000		L=2
22100		M=N/100000000
22200		IF(M.EQ.0)GO TO 2
22300		L=3
22400		N=N-100000000*M
22500	2	M=N/10000
22600		N=MOD(N,10000)
22700		IF(M.GT.1000)M=1000-M
22800		IF(N.GT.1000)N=1000-N
22900		END
23000	
23100		FUNCTION ROFF(R)
23200		S=.5
23300		IF(R)S=-S
23400		ROFF=R+S
23500		RETURN
23600		END
23700	
23800	
23900	C**************  NOIR, RJBX, CENTX ***************
24000		SUBROUTINE NOIR(RMINI)
24100	C  BLACKS IN NOTES
24200	      COMMON R2,JA,CENTR,J2,RJQ(20),JQ(12),B,C,KC,D,N,JY,M,L
24300		COMMON/PLTR/IPLT,RHT,DIS /XRN/IRN(4000)
24400		EQUIVALENCE (PRE,IRN(1))
24500		DATA BL/7.5/,BH/6.7/
24600	C  ADJUST BH AND FL FOR HEIGHT OF NOTE AND 'WIDTH'
24700		IPOS=ROFF(RJQ(1)*DIS)
24800	CC	IF(RMINI.LT..9)IPOS=IPOS+1
24900		JPOS=ROFF(CENTR*RHT)
25000		IF(-RMINI.EQ.PRE)GO TO 10
25100		PRE=-RMINI
25200	CC	D=.25*RMINI
25250		D=.25
25300		B=BH*RMINI*RHT
25400		E=RMINI*DIS
25500		A=BL*E
25600		IC=A
25700		A=A*A
26200		E=-B/4.
26300		K=B
26400		B=B*B
26500	C  USES EQUATION FOR ELLIPSE
26600		N=1
26700		NX=2
26800	6	DO 1 J=-K,K
26900		Y=J*J
27000		X=SQRT(A-(A*Y)/B)
27100		L=E-X
27200		M=X+E
27300	C  THE TWO SIDES OF THE LINE
27400		IF(N)CALL EXCH(L,M)
27500		IRN(NX)=L
27600		IRN(NX+1)=M
27700	C     C IS VERTICLE POS.
27800		NX=NX+2
27900		E=E+D
28000	C   E IS TO TILT IT.
28100	1	N=-N
28200	10	CALL PLOT(IPOS+3,JPOS,3)
28300		N=2
28400	C   1ST LOC. OF ARRAY HAS "PRE"
28500		L=IPOS+IC
28600		DO 11 M=-K,K
28700		J=M+JPOS
28800		CALL PLOT(L+IRN(N),J,2)
28900		CALL PLOT(L+IRN(N+1),J,2)
29000	11	N=N+2
29100		END
29200	
32200	CC	SUBROUTINE RJBX(R)
32300	CC     COMMON Q(4),R3,RJQ(39)/STF/RSTFAC(8),RSTJ2
32400	CC	R3=R3+R*RSTJ2
32500	CC	END
32600	
32700	CC	SUBROUTINE CENTX
32800	CC     COMMON A,B,CENTR,D,E,R4,R(38) /STF/RSTFAC(8),RSTJ2
32900	CC	1 /POSI/STFF(8),JJ2,POS
33000	CC	CENTR=POS-18.*RSTJ2+AMOD(R4,100.0)*RSTJ2*7.
33100	CC	END
33200	C******** THE ABOVE ARE NOW IN SMALL.FAI (3/75)
33210	
33300	C****** 7, STF, POS, HGT, NUM OF SHARPS OR FLATS(+ OR -), CLEF
33400	C		      (	CLEF = TREB,0  BASS,1  ALT,2  TEN,3 )
33500		SUBROUTINE KSIG
33600	C   FOR KEY SIGNATURES AND ACCENTS, ETC. (IN 'SCORE')
33700	      COMMON R2,JA,CENTR,J2,RJQ(20),JQ(17),T,S,Z/STF/RSTFAC(-3/4),RSTJ2
33800		EQUIVALENCE (R4,RJQ(2)),(J4,JQ(2)),(J5,JQ(3)),(J6,JQ(4))
33850		1,(R6,RJQ(4))
33900	
34000		JA=9
34100	C  USES THIS KEY NUM IN NOTWRT
34200	C   COUNTER
34300		IZ=IABS(J5)
34400	C  NUMBER OF CALLS ON NOTWRT
34500	C  THE CLEF NUM.  IT GETS WIPED OUT IN NOTWRT.
34600		JW=1
34610		R6=0
34700		IF(J5.GT.0)JW=2
34800	C   THE CODE FOR FLAT OR SHARP
34900	5333	CLEF=-(J6+1)
35000	C CLEF #S ARE CHNGD TO -1,-2,-3,-4 (TREB.,BA.,ALT.,TEN.)
35100	C  CLEF NOW SET IN MAIN PROG.
35200	C  IF NO CLEF GIVEN, TREBLE IS USED.
35300		T=10.
35400		IF(CLEF.LT.-2.)T=11.
35500		S=CLEF+4.
35600		IF(CLEF.EQ.-4)S=-1.
35700		IF(J5.LT.0)GO TO 253
35800		W=-3.
35900		YY=4.
36000		Z=11.
36100	C  SHARPS
36200		GO TO 353
36300	253	W=3.
36400		YY=-4.
36500		Z=7.
36600	C  FLATS
36700	353	N=1
36750		Z=Z+R4
36800		RX=JQ(1)
36900		RA=0
37000	C   RA IS AMOUNT TO BE ADDED TO ORIGINAL POS.
37100		DO 553 KA=1,IZ
37200		J5=JW
37300		RJQ(1)=RX+RA
37400		RA=RA+13.*RSTJ2
37500	C  MOVES OVER FOR NEXT ACCI.
37600		RD=Z
37700		R4=Z
37800		IF(CLEF.NE.-1.)GO TO 7
37900		IF(R4.GT.12.)R4=R4-7.
38000		GO TO 9
38100	7	R4=R4-S
38200		IF(R4.GT.T)R4=R4-7.
38300	C  ABOVE ARRANGES VERT. POS OF ACCIS.
38400	9	J4=R4
38500	C  FOR VERT. POS. IN 'DRWNT' (WHEN PLOTTING.)
38600		CALL CENTX
38700		CALL NOTWRT
38800		Z=RD+W
38900		IF(N)Z=RD+YY
39000	553	N=-N
39100		END